home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr05 / mswlogo3.zip / MSWLOGO.ZIP / EXAMPLES.ZIP / HANOI < prev    next >
Text File  |  1992-12-03  |  3KB  |  167 lines
  1. to hanoi :number 
  2. ;
  3. ; Towers of Hanoi
  4. ; Meyer A. Billmers
  5. ; November, 1983
  6. ;
  7. ; This procedure plays a graphic version of the Towers of Hanoi puzzle
  8. ; The argument is the number of disks in the configuration.
  9. ;
  10. ; c.f. putdisk, towercnt,towerset, hanoihlpr
  11. ; 
  12. local "from
  13. local "to
  14. local "other
  15. local "datfil
  16. ;make "datfil openw "hanoi.dat
  17. ;fileprint :datfil (sentence [Hanoi of ] :number [towers Started at: ] time)
  18. ; to change the starting and ending needles, change the next three assignments
  19. make "from 1
  20. make "to 3
  21. make "other 2
  22. cs
  23. ht
  24. penpaint
  25. setpensize [5 5]
  26. ; first we draw the table and the golden needles
  27. setpencolor 255 0 0
  28. pu
  29. setxy -350 -100
  30. pd
  31. setxy 350 -100
  32. pu
  33. setx -240
  34. pd
  35. fd 250
  36. pu
  37. setxy -15 -100
  38. pd
  39. fd 250
  40. pu
  41. setxy 210 -100
  42. pd
  43. fd 250
  44. make "tower1 0
  45. make "tower2 0
  46. make "tower3 0
  47. ; draw the initial stack of disks. note that putdisk draws the 
  48. ; "fixed up" towers.
  49. repeat :number ~
  50.    [~
  51.    putdisk :from :number - repcount + 1 "final ~
  52.    ifelse :from = 1 ~
  53.       [make "tower1 :tower1 + 1] ~
  54.       [ifelse :from = 2 ~
  55.          [make "tower2 :tower2 + 1] ~
  56.          [make "tower3 :tower3 + 1] ~
  57.       ] ~
  58.    ]
  59. hanoihlpr :number :from :to :other
  60. ; fileprint :datfil (sentence [Hanoi Ended at: ] time)
  61. ; close :datfil
  62. end
  63.  
  64. to hanoihlpr :number :from :to :other
  65. ;
  66. ; Called by HANOI. Contains the actual recursive Towers of Hanoi algorithm
  67. ;
  68. local "tcf 
  69. local "tct
  70. if equalp :number 0 [stop]
  71. hanoihlpr :number-1 :from :other :to
  72. make "tcf towercnt :from
  73. make "tct towercnt :to
  74. towerset :from :tcf - 1
  75. putdisk :from :number "temp
  76. putdisk :to :number "temp
  77. putdisk :from :number "erase
  78. putdisk :to :number "final
  79. towerset :to :tct + 1
  80. hanoihlpr :number-1 :other :to :from
  81. end
  82.  
  83. to putdisk :tnum :dnum :state
  84. ;
  85. ; Called by HANOI to put a disk on a tower.
  86. ; first arg. is number of tower (1,2 or 3)
  87. ; second arg. is number of disk to draw (1 is smallest)
  88. ; third arg. is "final, "temp, or "erase depending on whether
  89. ;   disk is drawn in final state, in temporary state to indicate
  90. ;   motion, or is being erased (removed from this tower)
  91. ; Note that this procedure re-draws the tower correctly.
  92. ;
  93. local "tc
  94. local "halfsize
  95. make "tc towercnt :tnum
  96. make "halfsize sum 20 product :dnum 10
  97. pu
  98. ifelse :tnum = 1 ~
  99.    [setxy "-240 "-100] ~
  100.    [ ~
  101.    ifelse :tnum = 2 ~
  102.       [setxy "-15 "-100] ~
  103.       [setxy 210 "-100] ~
  104.    ]
  105. pe
  106. fd product 30 :tc
  107. pu
  108. setxy xcor - :halfsize ycor
  109. pd
  110. penpaint
  111. ifelse :state = "final ~
  112.    [setpencolor 0 255 0] ~
  113.    [ ~
  114.    ifelse :state = "temp ~
  115.       [setpencolor 0 0 255] ~
  116.       [pe] ~
  117.    ]
  118. fd 30
  119. rt 90
  120. fd product :halfsize 2
  121. rt 90
  122. fd 30
  123. rt 90
  124. pu
  125. fd :halfsize
  126. rt 90
  127. setpencolor 255 0 0
  128. ifelse :state = "erase ~
  129.    [ ~
  130.    pd ~
  131.    penpaint ~
  132.    fd 30 ~
  133.    ] ~
  134.    [ ~
  135.    pe ~
  136.    fd 30 ~
  137.    ]
  138. end
  139.  
  140. to towercnt :tn
  141. ;
  142. ; Called by HANOI. Returns the current number of disks on tower :tn,
  143. ; as stored in the globals tower1, tower2, and tower3.
  144. ;
  145. ifelse :tn = 1 ~
  146.    [output :tower1] ~
  147.    [ ~
  148.    ifelse :tn = 2 ~
  149.       [output :tower2] ~
  150.       [output :tower3] ~
  151.    ]
  152. end
  153.  
  154. to towerset :tn :value
  155. ;
  156. ; Called by HANOI. Sets the current number of disks on tower :tn,
  157. ; as stored in the globals tower1, tower2, and tower3.
  158. ;
  159. ifelse :tn = 1 ~
  160.    [make "tower1 :value] ~
  161.    [ ~
  162.    ifelse :tn = 2 ~
  163.       [make "tower2 :value] ~
  164.       [make "tower3 :value] ~
  165.    ]
  166. end
  167.